perm filename XGPPOT.SAI[PIX,HPM]1 blob
sn#278206 filedate 1977-04-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "XGPSYN"
C00011 00003 DBUG←FALSE
C00016 00004 DO
C00019 00005 FPN←IF XGP THEN 2 ELSE 1 FPNR←0
C00022 00006 DO
C00028 00007 IF PAGE ∧ PN>0 THEN
C00030 00008 comment assemble line of text
C00031 00009 comment calculate height of line
C00036 00010 comment assemble line ALSO "BUG"
C00039 00011 PROCEDURE CHRDEP(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00045 00012 INTERNAL PROCEDURE CHRPED(INTEGER FNTNUM, CHR REFERENCE INTEGER PIC
C00051 00013 FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT)
C00063 00014 comment dislpay page
C00066 ENDMK
C⊗;
BEGIN "XGPSYN"
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
BOOLEAN PRNT,XGP,DBUG;
INTEGER ARRAY FHD[0:'17,0:'203];
INTEGER FNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER XCMP,YCMP,YOFF,XOFF,BMAR,RMAR,LMAR,TMAR,PMAR,QUAD,LUND;
INTEGER NCHN,I,NUMCH,TXTPNT;
INTEGER PN1,PN2,PN3;
INTEGER ARRAY PNS[0:300];
STRING INSTR,INFILE,S,HELPER,SWT;
OWN SAFE INTEGER ARRAY FNTAR[0:'17];
OWN SAFE STRING ARRAY FNTNAM[0:'17];
OWN STRING FILNM;
PRELOAD_WITH 0,0,0,0;
OWN SAFE INTEGER ARRAY CBUF[0:3];
PRELOAD_WITH -1,-1;
OWN SAFE INTEGER ARRAY CHO[1:2];
DEFINE FNTHIG='201;
DEFINE FNTBAS='203;
INTEGER PROCEDURE FNTSEL(INTEGER FNTNUM; STRING FILSPEC;
REFERENCE INTEGER FNTHEAD);
BEGIN "FNTSEL"
INTEGER ICHAN,FOO,IFLAG;
PRSFIL(FILSPEC);
FNTNAM[FNTNUM]←DEVPRS&":"&FILPRS;
FNTAR[FNTNUM]←LOCATION(FNTHEAD);
ICHAN←GETCHAN;
IFLAG←TRUE;
OPEN(ICHAN,DEVPRS,'10,2,0,FOO,FOO,IFLAG);
LOOKUP(ICHAN,FILPRS,IFLAG);
IF IFLAG THEN BEGIN RELEASE(ICHAN); RETURN(-1); END;
ARRYIN(ICHAN,MEMORY[LOCATION(FNTHEAD)+0],'204);
RELEASE(ICHAN);
RETURN(MEMORY[LOCATION(FNTHEAD)+'201]); comment return height of font;
END "FNTSEL";
PROCEDURE FCACHE(REFERENCE INTEGER CHE; INTEGER BFSZ);
BEGIN
CBUF[2]←CBUF[0]←LOCATION(CHE);
CBUF[3]←CBUF[1]←BFSZ;
END;
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN
WHILE LENGTH(INSTR)=0 ∧ ¬EOF DO INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; RETURN(LOP(INSTR));
END;
SIMPLE PROCEDURE MXCH(INTEGER M);
BEGIN
INTEGER I;
IF PRNT THEN FOR I←1 STEP 1 UNTIL M DO IDPB(NXCH,TXTPNT)
ELSE FOR I←1 STEP 1 UNTIL M DO NXCH;
END;
SIMPLE PROCEDURE SMXCH(INTEGER M);
BEGIN
INTEGER I;
FOR I←1 STEP 1 UNTIL M DO NXCH;
END;
SIMPLE INTEGER PROCEDURE PNXCH(INTEGER I);
BEGIN
INTEGER J;
J←I;
WHILE (J←J-1)≥0 ∧ LENGTH(INSTR)<I ∧ ¬EOF DO
INSTR←INSTR&INPUT(CHAN,1) ;
RETURN(INSTR[I TO I]);
END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 5],"FONT#") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNO←INTSCAN(FNTNMS,FOO);
FNTNMS←FNTNMS[2 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
OUTSTR("FONT#"&CVS(FTNO)&"="&FTNM&" ");
WHILE FNTSEL(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
OUTSTR("COULDN'T GET "&DEVPRS&":"&FILPRS&'15&'12);
OUTSTR("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
OUTSTR("FONT#"&CVS(FTNO)&"="&FTNM&" ");
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"FONT=") THEN
BEGIN
STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
OUTSTR("FONT#0="&FTNM&" ");
WHILE FNTSEL(0,FTNM,FHD[0,0])<0 DO
BEGIN
OUTSTR("COULDN'T GET "&DEVPRS&":"&FILPRS&'15&'12);
OUTSTR("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
OUTSTR("FONT#0="&FTNM&" ");
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"TMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
TMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("TMAR="&CVS(TMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"PMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
PMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("PMAR="&CVS(PMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"BMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
BMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("BMAR="&CVS(BMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"LMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
LMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("LMAR="&CVS(LMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"RMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
RMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("RMAR="&CVS(RMAR)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 6],"XLINE=") THEN
BEGIN
FNTNMS←FNTNMS[7 TO ∞];
XLINE←INTSCAN(FNTNMS,FOO);
OUTSTR("XLINE="&CVS(XLINE)&" ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"XGP") THEN
BEGIN
FNTNMS←FNTNMS[4 TO ∞];
XGP←TRUE;
OUTSTR("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 4],"-XGP") THEN
BEGIN
FNTNMS←FNTNMS[5 TO ∞];
XGP←FALSE;
OUTSTR("-XGP ");
END;
END;
END;
DBUG←FALSE;
HELPER←
"
XGPSYN displays pages from .XGP files (as produced by PUB and POX), on the
video synthesizer. It can show half pages at high resolution, full pages
lying on their side at barely readable resolution, or two unreadable pages
side by side, with their large scale structure visible.
To use it give it your file name when it asks. The .XGP extension is
assumed, and need not be typed. Then tell it the density you want, H (1/2
page), F (1 page) or D (2 pages). Next it goes into a loop asking for
page numbers. In H density you may specify a non integer page, 3.5, for
example, to see bottom half of page 3. In F density specify the full page
you wish to see. In D density the page you give, and the next one, are
displayed. Pages in files with too few formfeeds may be accessed by
appending a page count after the ff count (eg. 2-5 is the fifth page after
the ff indicating page 2). When the program types DONE, you may look at
the output at data disc terminals with <esc>47S. It usually helps to
adjust brightness and contrast.
Note that page 1 in .XGP files contains the font descriptions, and is not
interesting to display. You may also answer the page question with <cr> to
see the next window, H, F or D to change the density, V to redraw the last
display or K to erase the snthesizer.
The video synthesizer is a video rate D/A driven by data disc channels 30
through 37. H density requires 3 of these channels, F needs 4 and D wants
5. These are rarely available during heavy system load periods. About 10
CPU seconds are required to compose a single page.
Special modes: O outputs the last display as a hand/eye format picture file.
B density generates a 1 bit/sample uncompressed display of one page.
T density generates a sideways 1 bit/sample uncompressed display.
X sends the last display to the XGP, only sensible in B or T density.
";
OUTSTR("TYPE ?<CR> FOR HELP"&'15&'12&'12);
NCHN←0;
FOR I←0 STEP 1 UNTIL 2 DO IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN=0 THEN
OUTSTR("Right now there are no synthesizer channels available at all.
This program isn't worth running under those conditions."&'15&'12&'12)
ELSE IF NCHN<3 THEN
OUTSTR("Only "&CVS(NCHN)&" synthesizer channel"&
(IF NCHN=1 THEN " is" ELSE "s are")&" available, you probably don't
want to continue. Image quality will be very poor."&'15&'12&'12);
BREAKSET(1,"","A"); BREAKSET(1,'0&'177&'12&'14,"I"); BREAKSET(1,"","O");
BREAKSET(1,"","Z");
DDINIT;
TMAR←200;
PMAR←1796;
BMAR←200;
LMAR←200;
RMAR←1650;
XLINE←4;
BEGIN "FILE"
INTEGER FOO,HIG,POS,I,J; STRING FIRST,FIRST1,FIRST2,FIRST3;
DEFINE FSIZE=4000;
INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS;
REAL FPN,FPNR; BOOLEAN PAGE;
FIRST←"
(or H,F or D to change density,
or V to redraw display, or K to erase it,
or just <cr> for next window.)";
FIRST1←"
(eg. 3.5 for bottom of page 3 [or 2-1.5 in files without formfeeds])";
FIRST2←" <esc>47S to view";
FIRST3←" (and optional switches)";
FCACHE(FONT[0],FSIZE);
FNTSEL(0,"FIX25.FNT[XGP,SYS]",FHD[0,0]);
DO
BEGIN
STRING SF;
CHAN←GETCHAN;
OUTSTR("FILE NAME"&FIRST3&":");
FIRST3←"";
TTYUP(TRUE);
S←INCHWL;
TTYUP(FALSE);
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN OUTSTR(HELPER) ELSE
BEGIN "FILE"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".XGP");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
NUMCH←0; PNS[0]←0;
IF LENGTH(S)>0 THEN SWITCHES(S);
LASTFF←0;
IF XGP THEN
BEGIN
SWT←"";
WHILE PNXCH(1)≠'14 DO
BEGIN
INTEGER NX;
NX←NXCH;
IF NX≠'15∧NX≠'12∧NX≠" " THEN SWT←SWT&NX;
END;
NXCH;
SWITCHES(SWT);
PNS[1]←NUMCH;
LASTFF←1;
END;
OUTSTR('15&'12);
FPN←IF XGP THEN 2 ELSE 1; FPNR←0;
S←""; PN←2;
WHILE TRUE DO
BEGIN "DENSITY"
DO
BEGIN
IF LENGTH(S)=0 THEN
BEGIN
OUTSTR("HALF, FULL OR DOUBLE DENSITY (H,F, or D)?");
QUAD←INCHWL;
END
ELSE
QUAD←LOP(S);
IF QUAD="?" THEN OUTSTR(HELPER);
QUAD←QUAD LAND '137;
END
UNTIL QUAD="H" ∨ QUAD="F" ∨ QUAD="D" ∨ QUAD="B" ∨ QUAD="T";
XCMP←IF QUAD="B"∨QUAD="T" THEN 1 ELSE IF QUAD="D" THEN 6 ELSE 3;
YCMP←IF QUAD="B"∨QUAD="T" THEN 1 ELSE IF QUAD="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
INTEGER HI,WI,BI;
SAFE INTEGER ARRAY PIC[0:PIXDIM(HI←IF QUAD="B" THEN PMAR ELSE
IF QUAD="T" THEN RMAR-LMAR+1
ELSE 481,
WI←IF QUAD="B" THEN RMAR-LMAR+37 ELSE
IF QUAD="T" THEN (PMAR+36) MIN 1650
ELSE 512,
BI←IF QUAD="H" THEN 3
ELSE IF QUAD="F" THEN 4
ELSE IF QUAD="D" THEN 5
ELSE 1)];
MAKPIX(HI,WI,BI,PIC[0]);
NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
OUTSTR('15&'12&"Could only get "&CVS(NCHN)&" synthesizer channel"&
(IF NCHN=1 THEN "" ELSE "s")&", but need "&CVS(PIC[BYBI])&
". Image will be degraded."&'15&'12&'12);
DO
BEGIN "PAGES"
INTEGER FOO;
IF QUAD="D" THEN OUTSTR("FIRST PAGE #"&FIRST&":") ELSE
IF QUAD="F" ∨ QUAD="B" THEN OUTSTR("PAGE #"&FIRST&":") ELSE
BEGIN OUTSTR("PAGE"&FIRST1&FIRST&":"); FIRST1←""; END;
FIRST←"";
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
IF LENGTH(S)=0 THEN
BEGIN
PAGE←TRUE;
END
ELSE IF S="/" THEN
BEGIN
SWITCHES(S);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="X" THEN
BEGIN
IF QUAD="B" THEN VIDXGP(PIC[0],YOFF,XOFF,TMAR+PMAR+BMAR) ELSE
IF QUAD="T" THEN
BEGIN
VIDXGP(PIC[0],0,YOFF,RMAR);
IF DBUG THEN VIDXG(PIC[0],0,YOFF,RMAR);
END
ELSE VIDXGP(PIC[0],0,0,PIC[PCLN]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF QUAD="B"∨QUAD="T" THEN 0 ELSE DDSIZ];
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
IF PIC[BYBI]=1 THEN VID1(PIC[0],DBUF) ELSE
IF PIC[BYBI]=3 THEN VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF) ELSE
IF PIC[BYBI]=4 THEN
VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF) ELSE
VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE OUTSTR(" DONE"&'15&'12);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN
OUTSTR("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
UNGRAY(PIC[0]);
PUTPFL(PIC[0],INCHWL);
GRAY(PIC[0]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
MAPGRY(-1,0);
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
OUTSTR(HELPER);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="B" ∨ (S LAND '137)="T" ∨ (S LAND '137)="F"
∨ (S LAND '137)="D" ∨ (S LAND '137)="H" THEN
BEGIN
S←S LAND '137;
OUTSTR((IF S="B" THEN "bitwise" ELSE
IF S="T" THEN "bitwise transposed" ELSE
IF S="F" THEN "full" ELSE IF S="H" THEN "half" ELSE "double")
&" density"&'15&'12);
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO); IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN PN←FPN;
IF PAGE ∧ PN=1 ∧ XGP THEN
BEGIN
OUTSTR("Page 1 defines fonts, substance begins on page 2"&'15&'12);
PAGE←FALSE;
END
ELSE
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
LASTFF←PN-1;
WHILE LASTFF>0 ∧ PNS[LASTFF]=0 DO LASTFF←LASTFF-1;
EOF←FALSE;
USETI(CHAN,1+PNS[LASTFF]%('200*5));
INSTR←""; NUMCH←(PNS[LASTFF]%('200*5))*'200*5;
FOR I←(PNS[LASTFF] MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
END;
WIPE(PIC[0],0);
IF QUAD="T" THEN
BEGIN
YOFF←TMAR-36; XOFF←LMAR;
END
ELSE IF QUAD="B" THEN
BEGIN
YOFF←TMAR; XOFF←LMAR-36;
END
ELSE IF QUAD="H" THEN
BEGIN
YOFF←TMAR+(FPN-PN+FPNR)*(480*4-30);
XOFF←LMAR MIN (RMAR-3*512);
END
ELSE IF QUAD="F" THEN
BEGIN
YOFF←TMAR+FPNR*512*4;
XOFF←(LMAR-3) MIN (RMAR-3*480);
END
ELSE
BEGIN
YOFF←TMAR+FPNR*481*4;
XOFF←LMAR MIN (RMAR-3*512);
END;
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0; FNTN←0;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
WHILE ¬EOF ∧ LASTFF<(IF QUAD="D" THEN PN+1 ELSE PN) DO
BEGIN
INTEGER I,J,LC,YU,YL;
YL←0; YU←0;
PRNT←LASTFF≥PN-1;
IF QUAD="D" ∧ LASTFF=PN THEN
BEGIN
YOFF←TMAR+FPNR*481*4;
XOFF←(LMAR MIN (RMAR-3*512))-512*3;
END;
comment calculate height of line;
SBASE←BASE;
TXTPNT←POINT(7,DBUF,-1); DUN←FALSE;
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
PN1←PNXCH(1); PN2←PNXCH(2); PN3←PNXCH(3);
IF PN1=0 THEN SMXCH(1)
ELSE IF PN1='177 THEN
IF PN2='1 THEN
IF PN3≤'17 THEN
BEGIN
FTH←FHD[PN3,FNTHIG];
FTB←FHD[PN3,FNTBAS];
BASE←0;
MXCH(3);
END
ELSE IF PN3='43 THEN
BEGIN
BASE←((PNXCH(4) LSH 29) ASH -29);
MXCH(4);
END
ELSE IF PN3='52 THEN
BEGIN
BASE←BASE+((PNXCH(4) LSH 29) ASH -29);
MXCH(4);
END
ELSE IF PN3='40 THEN MXCH(5)
ELSE IF PN3='41 THEN
BEGIN
YU←YU MAX ((PNXCH(4) LSH 29) ASH -29);
YL←YL MIN ((PNXCH(4) LSH 29) ASH -29);
MXCH(6);
END
ELSE IF PN3='42 THEN
BEGIN
MXCH(4);
DUN←TRUE;
END
ELSE IF PN3='44 THEN MXCH(3)
ELSE IF PN3='45 THEN MXCH(4+PNXCH(4))
ELSE IF PN3='46 THEN MXCH(3)
ELSE IF PN3='47 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(4) LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
MXCH(4);
END
ELSE IF PN3='50 THEN MXCH(4)
ELSE IF PN3='51 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(5) LSH 29) ASH -29);
YU←YU MAX (YP+PNXCH(4)); YL←YL MIN YP;
MXCH(5);
END
ELSE MXCH(3)
ELSE IF PN2=2 THEN MXCH(3)
ELSE IF PN2=3 THEN
BEGIN
YPOS←PN3*128+PNXCH(4);
MXCH(4);
END
ELSE IF PN2=4 THEN MXCH(13)
ELSE IF PN2='11
∨ PN2='12
∨ PN2='14
∨ PN2='15
∨ (PN2≥'16 ∧PN2≤'177) THEN
BEGIN
MXCH(2);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE MXCH(2)
ELSE
BEGIN
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
PNS[LASTFF]←NUMCH+1;
OUTSTR(CVS(LASTFF)&" ");
END;
DUN←TRUE;
END;
MXCH(1);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END;
END "HEIGHT";
BASE←SBASE;
comment assemble line ALSO "BUG";
IF PRNT THEN
BEGIN "ASSEMBLE"
SIMPLE REAL PROCEDURE BUG(REAL X,Y; REFERENCE REAL XV,YV);
BEGIN
REAL FOOX,FOOY,XX,YY,BAZ,GLORPH;
COMMENT FIRST MAP ORIGIN CENTERED SQUARES TO ORIGIN CENTERED CIRCLES WEIRDLY;
IF X=0 ∨ Y=0
THEN BEGIN XX←X; YY←Y; END
ELSE BEGIN BAZ←(Y/X)↑2; IF BAZ>1 THEN BAZ←1/BAZ;
BAZ←SQRT(BAZ+1); XX←X/BAZ; YY←Y/BAZ; END;
COMMENT THEN ROTATE CIRCULAR PICTURE SOME FUNNY AMMOUNT;
GLORPH←3.14159*SIN(3.14159*SQRT(XX↑2+YY↑2))/2;
FOOX←COS(GLORPH); FOOY←SIN(GLORPH);
XV←XX*FOOX-YY*FOOY; YV←XX*FOOY+YY*FOOX;
COMMENT FINALLY MAP CIRCLES BACK INTO SQUARES;
IF XV≠0 ∧ YV≠0 THEN BEGIN BAZ←(YV/XV)↑2; IF BAZ>1 THEN BAZ←1/BAZ;
BAZ←SQRT(BAZ+1); XV←XV*BAZ; YV←YV*BAZ; END;
END;
PROCEDURE CHRDEP(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO, YCOMP(1),XCOMP(1));
BEGIN "CHRDEP"
INTEGER ICHAN,FOO,POS,I,J,RASW;
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,2,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(CHAR[0] ASH -27);
YLO←YLO+((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
REAL XRP,YRP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
BEGIN
YRP←YLO+I;
XRP←XLO+J;
XRP←(XRP-850)/850;
YRP←(YRP-1100)/1100;
BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
ADDEL(PIC,(YRP-YOFF)/YCOMP,(XRP-XOFF)/XCOMP,1);
END;
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(MEMORY[POS+1] ASH -27);
YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
REAL XRP,YRP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
BEGIN
YRP←YLO+I;
XRP←XLO+J;
XRP←(XRP-850)/850;
YRP←(YRP-1100)/1100;
BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
ADDEL(PIC,(YRP-YOFF)/YCOMP,(XRP-XOFF)/XCOMP,1);
END;
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRDEP";
INTERNAL PROCEDURE CHRPED(INTEGER FNTNUM, CHR; REFERENCE INTEGER PIC;
INTEGER YLO,XLO, YCOMP(1),XCOMP(1));
BEGIN "CHRPED"
INTEGER ICHAN,FOO,POS,I,J,RASW,PHI;
PHI←MEMORY[LOCATION(PIC)+PCLN];
YLO←YLO-MEMORY[FNTAR[FNTNUM]+FNTBAS];
IF (MEMORY[FNTAR[FNTNUM]+CHR]) LAND '777777≠0 THEN
BEGIN "REAL"
POS←MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777;
POS←(POS LSH 18) ASH -18;
IF POS>0 THEN
BEGIN "READA"
IF CHO[1]≠FNTNUM THEN
BEGIN
IF CHO[2]≠-1 THEN RELEASE(CHO[2]);
PRSFIL(FNTNAM[FNTNUM]);
CHO[2]←GETCHAN;
FOO←1;
OPEN(CHO[2],DEVPRS,'10,2,0,FOO,FOO,FOO);
LOOKUP(CHO[2],FILPRS,FOO);
CHO[1]←FNTNUM;
END;
USETI(CHO[2],POS%128 + 1);
FOR I←1 STEP 1 UNTIL (POS MOD 128) DO WORDIN(CHO[2]);
RASW←WORDIN(CHO[2]);
IF (RASW LSH -27)=0 THEN
RASW←RASW LOR ((MEMORY[FNTAR[FNTNUM]+CHR] LSH -18) LSH 27);
BEGIN "READ"
INTEGER NROW,PTQ;
INTEGER ARRAY CHAR[0:(RASW LAND '777777)-2];
ARRYIN(CHO[2],CHAR[0],(RASW LAND '777777)-1);
IF CBUF[1]≥(RASW LAND '777777) THEN
BEGIN
MEMORY[CBUF[0]]←RASW;
ARRBLT(MEMORY[CBUF[0]+1],CHAR[0],(RASW LAND '777777)-1);
MEMORY[FNTAR[FNTNUM]+CHR]←
(MEMORY[FNTAR[FNTNUM]+CHR] LAND '777777000000) LOR
((-CBUF[0]) LAND '777777);
CBUF[0]←CBUF[0]+(RASW LAND '777777);
CBUF[1]←CBUF[1]-(RASW LAND '777777);
END
ELSE
OUTSTR("!");
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(CHAR[0] ASH -27);
YLO←YLO+((CHAR[0] LSH 9) LSH -27);
NROW←CHAR[0] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,CHAR[1],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
BEGIN "PACK"
REAL XRP,YRP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
BEGIN
YRP←YLO+I;
XRP←XLO+J;
XRP←(XRP-850)/850;
YRP←(YRP-1100)/1100;
BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
ADDEL(PIC,PHI-(XRP-XOFF)/XCOMP,(YRP-YOFF)/YCOMP,1);
END;
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "READA"
ELSE
BEGIN "BUFA"
POS←-POS;
RASW←MEMORY[POS];
BEGIN "READ"
INTEGER NROW,PTQ;
RASW←RASW LSH -27;
IF RASW=0 THEN RASW←MEMORY[FNTAR[FNTNUM]+CHR] LSH -18;
XLO←XLO-(MEMORY[POS+1] ASH -27);
YLO←YLO+((MEMORY[POS+1] LSH 9) LSH -27);
NROW←MEMORY[POS+1] LAND '777777;
IF NROW*RASW>0 THEN PTQ←POINT(1,MEMORY[POS+2],-1);
FOR I←0 STEP 1 UNTIL NROW-1 DO
BEGIN "PACK"
REAL XRP,YRP;
FOR J←0 STEP 1 UNTIL RASW-1 DO IF ILDB(PTQ) THEN
BEGIN
YRP←YLO+I;
XRP←XLO+J;
XRP←(XRP-850)/850;
YRP←(YRP-1100)/1100;
BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
ADDEL(PIC,PHI-(XRP-XOFF)/XCOMP,(YRP-YOFF)/YCOMP,1);
END;
IF (PTQ LSH -30) < RASW THEN PTQ←PTQ LAND '7777777777;
END "PACK";
END "READ";
END "BUFA";
END "REAL";
END "CHRPED";
FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT);
TXTPNT←POINT(7,DBUF,-1);
YPOS←YPOS-YL;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTHIG];
WHILE ILDB(TXTPNT)>0 DO
BEGIN "ASSLP"
IF LDB(TXTPNT)='177 THEN
IF ILDB(TXTPNT)='1 THEN
IF ILDB(TXTPNT)≤'17 THEN
BEGIN
FTH←FHD[FNTN←LDB(TXTPNT),FNTHIG];
FTB←FHD[FNTN←LDB(TXTPNT),FNTBAS];
BASE←0;
END
ELSE IF LDB(TXTPNT)='43 THEN
BASE←((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)='52 THEN
BASE←BASE+((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)='40 THEN
XPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)
ELSE IF LDB(TXTPNT)='41 THEN
BEGIN
INTEGER XP,YP,XNEW;
YP←(YPOS+((ILDB(TXTPNT) LSH 29) ASH -29));
XNEW←XPOS+ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR XP←XPOS STEP 1 UNTIL XNEW DO
BEGIN
REAL XRP,YRP,RRP;
XRP←(XP-850)/850;
YRP←(YP-1100)/1100;
BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
IF QUAD="F" ∨ QUAD="T" THEN
ADDEL(PIC[0],PIC[PCLN]-(XRP-XOFF)/XCMP,
(YRP-YOFF)/YCMP,1)
ELSE
ADDEL(PIC[0],(YRP-YOFF)/YCMP,
(XRP-XOFF)/XCMP,1);
END;
XPOS←XNEW;
END
ELSE IF LDB(TXTPNT)='42 THEN
YPOS←YPOS+YU+ILDB(TXTPNT)
ELSE IF LDB(TXTPNT)='44 THEN BEGIN END
ELSE IF LDB(TXTPNT)='45 THEN
BEGIN
INTEGER N,J;
N←ILDB(TXTPNT);
FOR J←1 STEP 1 UNTIL N DO IBP(TXTPNT);
END
ELSE IF LDB(TXTPNT)='46 THEN LUND←XPOS
ELSE IF LDB(TXTPNT)='47 THEN
BEGIN
INTEGER XP,YP;
YP←(YPOS+((ILDB(TXTPNT) LSH 29) ASH -29));
FOR XP←LUND STEP 1 UNTIL XPOS DO
BEGIN
REAL XRP,YRP,RRP;
XRP←(XP-850)/850;
YRP←(YP-1100)/1100;
BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
IF QUAD="F" ∨ QUAD="T" THEN
ADDEL(PIC[0],PIC[PCLN]-(XRP-XOFF)/XCMP,
(YRP-YOFF)/YCMP,1)
ELSE
ADDEL(PIC[0],(YRP-YOFF)/YCMP,
(XRP-XOFF)/XCMP,1);
END;
END
ELSE IF LDB(TXTPNT)='50 THEN IBP(TXTPNT)
ELSE IF LDB(TXTPNT)='51 THEN
BEGIN
INTEGER XP,YP,TH,THK;
THK←ILDB(TXTPNT);
YP←(YPOS+((ILDB(TXTPNT) LSH 29) ASH -29));
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
BEGIN
REAL XRP,YRP,RRP;
XRP←(XP+TH-850)/850;
YRP←(YP-1100)/1100;
RRP←BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
IF QUAD="F" ∨ QUAD="T" THEN
ADDEL(PIC[0],PIC[PCLN]-(XRP-XOFF)/XCMP,
(YRP-YOFF)/YCMP,1)
ELSE
ADDEL(PIC[0],(YRP-YOFF)/YCMP,(XRP-XOFF)/XCMP,1);
END;
END
ELSE BEGIN END
ELSE IF LDB(TXTPNT)=2 THEN
XPOS←XPOS+((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)=3 THEN
YPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)-YL
ELSE IF LDB(TXTPNT)=4 THEN
BEGIN
INTEGER J,K,Y0,N,W; REAL DX,X0;
Y0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
X0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
DX←((ILDB(TXTPNT)*16384+ILDB(TXTPNT)*128+ILDB(TXTPNT))
LSH 15) ASH -15;
DX←DX/2↑9;
N←ILDB(TXTPNT)*128+ILDB(TXTPNT);
W←ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR J←0 STEP 1 UNTIL N-1 DO
FOR K←0 STEP 1 UNTIL W-1 DO
BEGIN
REAL XRP,YRP,RRP;
XRP←(K+X0+DX*J-850)/850;
YRP←(J+Y0-1100)/1100;
RRP←BUG(XRP,YRP,XRP,YRP);
XRP←XRP*850+850;
YRP←YRP*1100+1100;
IF QUAD="F" ∨ QUAD="T" THEN
ADDEL(PIC[0],PIC[PCLN]-(XRP-XOFF)%XCMP,
(YRP-YOFF)%YCMP,1)
ELSE
ADDEL(PIC[0],(YRP-YOFF)%YCMP,
(XRP-XOFF)%XCMP,1);
END;
END
ELSE IF LDB(TXTPNT)='11 ∨
LDB(TXTPNT)='12 ∨
LDB(TXTPNT)='14 ∨
LDB(TXTPNT)='15 ∨
(LDB(TXTPNT)≥'16 ∧ LDB(TXTPNT)≤'177) THEN
BEGIN
IF QUAD="F"∨QUAD="T" THEN
CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE,XPOS,YCMP,XCMP)
ELSE
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE,XPOS,YCMP,XCMP);
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18);
END
ELSE BEGIN END
ELSE IF LDB(TXTPNT)='12 THEN
YPOS←YPOS+YU+XLINE
ELSE IF LDB(TXTPNT)='15 THEN
XPOS←LMAR
ELSE IF LDB(TXTPNT)='11 THEN
BEGIN
INTEGER BLANW;
BLANW←FHD[FNTN,'40] LSH -18;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
END
ELSE IF LDB(TXTPNT)='14 THEN
BEGIN
XPOS←LMAR;
YPOS←TMAR;
END
ELSE IF LDB(TXTPNT)≠0 THEN
BEGIN
IF QUAD="F"∨QUAD="T" THEN
CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE,XPOS,YCMP,XCMP)
ELSE
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE,XPOS,YCMP,XCMP);
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18);
END
ELSE ;
END"ASSLP";
END "ASSEMBLE";
END;
comment dislpay page;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]); GRAY(PIC[0]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF QUAD="B"∨QUAD="T" THEN 0 ELSE DDSIZ];
DDINIT;
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
IF PIC[BYBI]=1 THEN VID1(PIC[0],DBUF) ELSE
IF PIC[BYBI]=3 THEN VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF) ELSE
IF PIC[BYBI]=4 THEN
VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF) ELSE
VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE OUTSTR(" DONE"&FIRST2&'15&'12);
FIRST2←"";
IF QUAD="H"∨QUAD="T" THEN FPN←FPN+.5 ELSE
IF QUAD="F"∨QUAD="B" THEN FPN←(PN←FPN)+1 ELSE
IF QUAD="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END "XGPSYN";